home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / INITIAL2.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-14  |  15KB  |  490 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  9-14-88 6:15 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit Initial2;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TpCrt, Dos, Globals, TPSTRING, TPDOS,
  19.   TAccess, Core1, Core2, Misc;
  20.   
  21.   
  22. procedure setup;
  23.  
  24. procedure wait_for_user;
  25.  
  26. procedure get_nmh;
  27.  
  28.  
  29.   {==========================================================================}
  30.   
  31.   
  32. Implementation
  33.  
  34.  
  35.   procedure setup;
  36.   
  37.   var
  38.     i, x            : Integer;
  39.     first, OK       : Boolean;
  40.     test_file       : file;
  41.     
  42.   begin
  43.     valid_pw := False;
  44.     first := False;
  45.     fini := False;
  46.     connected := False;
  47.     local_online := False;
  48.     local_copy := True;
  49.     printer_copy := False;
  50.     remote_online := False;
  51.     remote_copy := False;
  52.     macro_file_exists := False;
  53.     AreaReq := '';
  54.     SectReq := '';
  55.     
  56.     mode := message_mode;         { Start system in message mode }
  57.     nonstop := False;             { no message scrolling}
  58.     st_switch := True;            { Default file size display - in 'k' }
  59.     new_dir := False;             { Reset directory flag }
  60.     up_down_display := True;      { Show up/downloads for files mode }
  61.     extra_time := 0;              { None until upload complete }
  62.     op_chat := False;             { chat not initiated }
  63.     in_chat := False;                                  
  64.     last_time_left := 6;
  65.     
  66.     user_rec.nulls := 2;          { 2 nulls until recognition }
  67.     user_rec.shift_lock := False; { Upper case only to start }
  68.     user_rec.noisy := False;      { Prompt bell initially off }
  69.     user_rec.columns := def_chars;
  70.     user_rec.lines := def_lines;
  71.     
  72.     timeout := 60;                { Allow one minute for input }
  73.     
  74.     Assign(test_file, user_data+ext);
  75.     {$I-}
  76.     Reset(test_file); {$I+}
  77.     if IoResult = 0 then
  78.       begin
  79.         OK := (FileSize(test_file) > 0);
  80.         Close(test_file)
  81.       end
  82.     else
  83.       OK := False;
  84.       
  85.     if OK then
  86.       begin
  87.         Assign(test_file, user_indx+ext);
  88.         {$I-}
  89.         Reset(test_file); {$I+}
  90.         if IoResult = 0 then
  91.           begin
  92.             OK := (FileSize(test_file) > 0);
  93.             Close(test_file)
  94.           end
  95.         else
  96.           OK := False;
  97.       end;
  98.     if OK then
  99.       begin
  100.         OpenFile(DatF, user_data+ext, SizeOf(user_rec));
  101.         OpenIndex(IdxF, user_indx+ext, len_ln+len_fn, 0)
  102.       end
  103.     else
  104.       begin
  105.         WriteLn(BEL, BEL, BEL, 'IMPORTANT');
  106.         WriteLn('If your CONFIG.SYS file does not contain a FILES=20 statement');
  107.         WriteLn('an I/O error will occur during this initialization !');
  108.         WriteLn;
  109.         Delay(5000);
  110.         Write(BEL, 'User files not found.  Creating ', user_data, ext);
  111.         MakeFile(DatF, user_data+ext, SizeOf(user_rec));
  112.         Write(', ', user_indx, ext);
  113.         MakeIndex(IdxF, user_indx+ext, len_ln+len_fn, 0);
  114.         WriteLn;
  115.         first := True;
  116.       end;
  117.       
  118.       
  119.     if (not ExistFile(area_indx+ext)) then
  120.       begin
  121.         WriteLn(BEL, 'Newin index not found.  Creating ', area_indx, ext);
  122.         MakeIndex(NewinArea, area_indx+ext, 12, Duplicates);
  123.       end
  124.     else
  125.       OpenIndex(NewinArea, area_indx+ext, 12, Duplicates);
  126.       
  127.       
  128.       
  129.     if (not ExistFile(name_indx+ext)) then
  130.       begin
  131.         WriteLn(BEL, 'Newin index not found.  Creating ', name_indx, ext);
  132.         MakeIndex(NewinName, name_indx+ext, 12, Duplicates);
  133.       end
  134.     else
  135.       OpenIndex(NewinName, name_indx+ext, 12, Duplicates);
  136.       
  137.       
  138.     {$I-}
  139.     Reset(logr_file) {$I+} ;
  140.     OK := (IoResult = 0);
  141.     if (not OK) or (OK and (FileSize(logr_file) = 0)) then
  142.       begin
  143.         Write(BEL, 'Log file not found.  Creating ', logr_name, ext);
  144.         Rewrite(logr_file);
  145.         logr_rec.user := 0;
  146.         Write(logr_file, logr_rec);
  147.         FlushAny(logr_file);
  148.         WriteLn;
  149.         first := True;
  150.       end;
  151.     {$I-}
  152.     Reset(summ_file) {$I+} ;
  153.     OK := (IoResult = 0);
  154.     if OK then
  155.       begin
  156.         {$I-}
  157.         Reset(mesg_file) {$I+} ;
  158.         OK := (IoResult = 0)
  159.       end;
  160.     if (not OK) or (OK and (FileSize(summ_file) = 0)) then
  161.       begin
  162.         Write(BEL, 'Message files not found.  Creating ', summ_name, ext);
  163.         Rewrite(summ_file);
  164.         summ_rec.num := 0;
  165.         Write(summ_file, summ_rec);
  166.         Write(', ', mesg_name, ext);
  167.         Rewrite(mesg_file);
  168.         WriteLn;
  169.         first := True;
  170.       end;
  171.     Assign(stat_file, stat_name+ext);
  172.     {$I-}
  173.     Reset(stat_file) {$I+} ;
  174.     if (IoResult = 0) and (FileSize(stat_file) > 0) then
  175.       Read(stat_file, stat_rec) 
  176.     else
  177.       begin
  178.         Write(BEL, 'Statistics file not found.  Creating ', stat_name, ext);
  179.         Rewrite(stat_file);
  180.         GetTAD(stat_rec.date);
  181.         for i := 0 to 23 do
  182.           stat_rec.busy_per_hour[i] := 0;
  183.         for i := 0 to 6 do
  184.           stat_rec.busy_per_day[i] := 0;
  185.         WriteLn;
  186.         first := True;
  187.       end;
  188.     Close(stat_file);
  189.     {$I-}
  190.     Reset(nwin_file) {$I+} ;
  191.     if IoResult <> 0 then
  192.       begin
  193.         Write(BEL, 'Newin file not found.  Creating ', nwin_name, ext);
  194.         Rewrite(nwin_file);
  195.         with nwin_rec do
  196.           begin
  197.             name := 'ENTRY.1ST';
  198.             descr := ('A dummy entry');
  199.             GetTAD(date);
  200.             user := 0;
  201.             sectn := '*NEWIN';
  202.             status := public;
  203.             dnloads := 0;
  204.             for x := 0 to 5 do
  205.               last_dnload[x] := 0;
  206.           end;
  207.         Write(nwin_file, nwin_rec);
  208.         WriteLn;
  209.         first := True;
  210.       end;
  211.       
  212.       
  213.     if (not ExistOnPath('COMMAND.COM', CommandPath)) then
  214.       begin
  215.         Write(BEL, 'Couldn''t find COMMAND.COM in path.  Aborting.. ');
  216.         Halt
  217.       end
  218.     else
  219.       CommandPath := FullPathName(CommandPath);
  220.       
  221.       
  222.     if (not ExistOnPath('DSZ.COM', DSZPath)) and (not ExistOnPath('DSZ.EXE', DSZPath)) then
  223.       begin
  224.         Write(BEL, 'Couldn''t find DSZ in path.  Aborting.. ');
  225.         Halt
  226.       end
  227.     else
  228.       DSZPath := FullPathName(DSZPath);
  229.       
  230.       
  231.     if cold then
  232.       begin
  233.         if (not cmd_tail) then log(0, '');
  234.         cold := False;
  235.       end;
  236.     if first then
  237.       Delay(5000);
  238.   end;
  239.   
  240.   
  241.   procedure wait_for_user;
  242.   
  243.   var
  244.     ch              : Char;
  245.     bt              : Byte;
  246.     count_limit,
  247.     count,
  248.     counter, i, x,
  249.     delay_count,
  250.     resend          : Integer;
  251.     t               : tad_array;
  252.     timeout         : Boolean;
  253.     Rcv_Space,
  254.     Hom_space       : Longint;
  255.     
  256.   begin
  257.     NetMsgEntr := 0;
  258.     EchoMsgEntr := 0;
  259.     if (not cmd_tail) or (cmd_tail and (strint(ParamStr(1)) = 99))
  260.     or (cmd_tail and (strint(ParamStr(1)) = 98)) then
  261.       begin
  262.         ClrScr;
  263.         count_limit := 12000;
  264.         if delay_down then
  265.           begin
  266.             putstat('Waiting for delayed shutdown acknowledgement...', ' ');
  267.             mdbusy;
  268.           end
  269.         else
  270.           begin
  271.             putstat(Center(version+' as of '+ver_date+
  272.               '    Copyright (c) 1987,88 by', 79),
  273.               Center('Jon Schneider & Rick Petersen,  El Paso, TX.', 79)
  274.               );
  275.             if (not cmd_tail) then mdinit;
  276.           end;
  277.         GetTAD(t);
  278.         Rcv_Space := (diskfree(Ord(Upcase(RcvDrv[1]))-64) div 1024);
  279.         Hom_space := (diskfree(Ord(Upcase(HomDrv[1]))-64) div 1024);
  280.         if macro_in_progress then
  281.           begin
  282.             macro_in_progress := False;
  283.             if macro_file_exists then
  284.               begin
  285.                 Close(macro_file);
  286.                 macro_file_exists := False;
  287.               end;
  288.             GetTAD(t);
  289.             macro_done := t[3];
  290.             local_online := False;
  291.           end;
  292.         count := 0;
  293.         counter := 0;
  294.         delay_count := 0;
  295.         resend := 0;
  296.         repeat
  297.           if ((auto_macro) and (macro_done <> t[3]) and (t[2] >= auto_macro_start)
  298.             and (not macro_in_progress)) or
  299.           (cmd_tail and (strint(ParamStr(1)) = 98)) then
  300.             begin
  301.               Assign(macro_file, 'MACRO.LST');
  302.               {$I-}
  303.               Reset(macro_file); {$I+}
  304.               if IoResult = 0 then
  305.                 begin
  306.                   macro_file_exists := True;
  307.                   WriteLn('Starting auto macro execution.');
  308.                   macro_in_progress := True;
  309.                 end;
  310.               if (not macro_file_exists) and (Length(macro) > 0) then
  311.                 begin
  312.                   WriteLn('Starting auto macro execution.');
  313.                   macro_in_progress := True;
  314.                   st := macro;
  315.                   repeat
  316.                     i := Pos('^M', st);
  317.                     if i > 0 then
  318.                       begin
  319.                         Delete(st, i, 2);
  320.                         Insert(Chr(13), st, i);
  321.                       end;
  322.                   until i = 0;
  323.                   Cmd_Queue := st;
  324.                   mult_cmds := True;
  325.                 end;
  326.             end;
  327.             
  328.           if (counter > 30000) or (counter = 0) then
  329.             begin
  330.               if delay_down then
  331.                 begin
  332.                   ClrScr;
  333.                   WriteLn;
  334.                   GoToXY(5, 20);
  335.                   WriteLn('COUNT DOWN TO SYSTEM RE-ACTIVATION... ', 75-delay_count);
  336.                   WriteLn;
  337.                 end;
  338.               GoToXY(10, 15);
  339.               if Rcv_Space < maxfree_uplds then
  340.                 WriteLn('UPLOADS OFF DUE TO DISK SPACE LIMITS !');
  341.               if Hom_space < maxfree_logs then
  342.                 WriteLn('NEW LOGINS OFF DUE TO DISK SPACE LIMITS !');
  343.               if Hom_space < maxfree_mslimit then
  344.                 WriteLn('MESSAGES LIMITED DUE TO DISK SPACE LIMITS !');
  345.               if (Hom_space < maxfree_abs) or (Rcv_Space < maxfree_abs) then
  346.                 begin
  347.                   WriteLn;
  348.                   WriteLn('EXTREME DISK SPACE PROBLEMS !!!!!!!!!');
  349.                 end;
  350.               counter := 1;
  351.             end;
  352.           Inc(count);
  353.           Inc(counter);
  354.           if counter = 10000 then
  355.             ClrScr;
  356.           if count > count_limit then
  357.             begin
  358.               GetTAD(t);
  359.               putstat('', '');
  360.               GoToXY(Succ(Random(79)), Succ(Random(23)));
  361.               count := 0;
  362.               Inc(resend);
  363.               if resend > 200 then
  364.                 begin
  365.                   resend := 0;
  366.                   mdinit
  367.                 end;
  368.               if delay_down then
  369.                 Inc(delay_count);
  370.             end;
  371.           if delay_down then
  372.             begin
  373.               Write(BEL);
  374.               if delay_count >= 75 then
  375.                 begin
  376.                   delay_down := False;
  377.                   delay_count := 0;
  378.                   mdhangup;
  379.                 end;
  380.             end;
  381.           ch := GetChar;
  382.           if (ch = LF) or (ch = CR) then
  383.             begin
  384.               ClrScr;
  385.               WriteLn;
  386.               WriteLn(Center(' '+version+' as of '+ver_date, 79));
  387.               WriteLn(Center(' Copyright (c) 1987,88 by', 79));
  388.               WriteLn(Center(' Jon Schneider & Rick Petersen,  El Paso, TX.', 79));
  389.               GotoXY(1, 20);
  390.               WriteLn(Center(' ^C to exit TPBoard,  ^L for local use.', 79));
  391.               HiddenCursor;
  392.               MakeWindow;
  393.               i := 1;
  394.               if Ch_Carck then
  395.                 x := 30
  396.               else
  397.                 x := 32000;
  398.               repeat
  399.                 bt := GetByte(1, timeout);
  400.                 if bt > 0 then
  401.                   i := x;         {key pressed remotely}
  402.                 Inc(i);
  403.               until KeyPressed or (i >= x);
  404.               NormalCursor;
  405.               ClrScr;
  406.             end;
  407.           if ch = ETX then
  408.             begin
  409.               ClrScr;
  410.               WriteLn;
  411.               Write('Busy modem [Y/n] ? >');
  412.               ch := ReadKey;
  413.               if Upcase(ch) = 'N' then
  414.                 mdhangup
  415.               else
  416.                 mdbusy;
  417.               ClrScr;
  418.               WriteLn;
  419.               WriteLn('TPBoard completing...');
  420.               log(1, '');
  421.               CloseFile(DatF);
  422.               CloseIndex(IdxF);
  423.               Close(sysm_file);
  424.               Close(summ_file);
  425.               Close(mesg_file);
  426.               Close(logr_file);
  427.               Close(stat_file);
  428.               Close(nwin_file);
  429.               fini := True
  430.             end
  431.           else if (ch = FF) or (macro_in_progress)
  432.           or (cmd_tail and (strint(ParamStr(1)) = 99))
  433.           {control L}
  434.           then
  435.             begin
  436.               putstat('Local use requested', ' ');
  437.               rate := 300;
  438.               mdbusy;
  439.               local_online := True
  440.             end
  441.           else if mdring then
  442.             begin
  443.               putstat('Ring detected', ' ');
  444.               mdans;
  445.               remote_online := Ch_Carck;
  446.               remote_copy := remote_online;
  447.               if remote_online then
  448.                 putstat('Connect at '+intstr(rate, 3)+' bps', ' ');
  449.             end
  450.         until fini or local_online or remote_online;
  451.         delay_down := False
  452.       end
  453.     else
  454.       begin
  455.         ClrScr;
  456.         Rcv_Space := (diskfree(Ord(Upcase(RcvDrv[1]))-64) div 1024);
  457.         Hom_space := (diskfree(Ord(Upcase(HomDrv[1]))-64) div 1024);
  458.         rate := strint(ParamStr(1));
  459.         time_to_event := strint(ParamStr(2));
  460.         if time_to_event = 0 then
  461.           get_nmh;
  462.         Ch_Init;
  463.         Ch_Set(rate);
  464.         remote_online := Ch_Carck;
  465.         remote_copy := remote_online;
  466.         delay_down := False
  467.       end;
  468.   end;
  469.   
  470.   
  471.   procedure get_nmh;
  472.   
  473.   var
  474.     t               : tad_array;
  475.     current, nmh    : Integer;
  476.     
  477.   begin
  478.     GetTAD(t);
  479.     current := (60*t[2])+t[1];
  480.     nmh := 60*auto_macro_start;
  481.     if nmh < current then
  482.       nmh := nmh+1440;
  483.     time_to_event := nmh-current
  484.   end;
  485.   
  486.   
  487. end.                              { of INITIAL2.PAS }
  488.  
  489. 
  490.